unit MainctrlFrm;

{$mode objfpc}{$H+}

interface

uses
  windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, LazUTF8,
  ExtCtrls, StdCtrls, Menus, fpjson, ubase64, UCommon, socketserver, DataModule;

type
  TExec = procedure(soc: DWord; jsparam: TJSONObject) of object;
  { TMainCtrlForm }

  TMainCtrlForm = class(TForm)
    IdleTimer: TIdleTimer;
    ImageList: TImageList;
    Memo: TMemo;
    ppmOnShow: TMenuItem;
    MenuItem2: TMenuItem;
    ppmOnClose: TMenuItem;
    Panel1: TPanel;
    PanTitle: TPanel;
    PopMenu: TPopupMenu;
    TrayIcon: TTrayIcon;
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure ppmOnShowClick(Sender: TObject);
    procedure ppmOnCloseClick(Sender: TObject);
    procedure OnWMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
    procedure IdleTimerTimer(Sender: TObject);
  private
    CmdClose : Boolean;
  public

  end;

procedure OnReceive(soc: DWord; buf: PChar; len: DWord); stdcall;
procedure OnAccept(soc: DWord); stdcall;
procedure OnExcept(str: PChar); stdcall;

var
  MainCtrlForm: TMainCtrlForm;
  logdir, logfile: string;
  filename : string = '_.txt';
  logf : TextFile;
const
  INVALIDTIME: double = 1.5;

implementation

procedure OnReceive(soc: DWord; buf: PChar; len: DWord); stdcall;
var
  b : PBYTE;
  n : dword;
  es, js, cs: string;
  jsonObj, jsParam: TJSONObject;
  R: TMethod;
  Exec: TExec;
  Atime: TDateTime;
begin
  //MainCtrlForm.Memo.Lines.Add(PChar(buf));
  n := len;
  GetMem(b, n);
  FillChar(b^, n, 0);
  // 第一步：解码
  Base64Decode(buf, len, b, n);
  // 第二步：解密
  es := PChar(b);
  //MainCtrlForm.Memo.Lines.Add(es);
  js := TFun.Decrypt(es);
  // 获取一个JSON
  jsonObj := TJSONObject(GetJSON(js));
  Atime := jsonObj.Get('TIME', 0.0);
  if (abs(Now() - ATime) >= INVALIDTIME) then
    Exit;  // 超时一天时间
  jsParam := TJSONObject(jsonObj.Find('PARM'));
  // 字符串-调用相关函数
  cs := jsonObj.Get('CMD','');
  R.Data := Pointer(DM);
  R.Code := DM.MethodAddress(cs) ;
  if Assigned(R.Code) then
  begin
   Exec := TExec(R);
   Exec(soc, jsParam);
  end;
end;

procedure OnAccept(soc: DWord); stdcall;
var
  s : string;
begin
  s := Format('%s 连接到客户端 %s ',[FormatDateTime('yyyy-MM-dd hh:mm:ss', Now), getSocketAddr(soc)]);
  WriteLn(logf, s);
  MainCtrlForm.Memo.Lines.Add(s);
end;

procedure OnExcept(str: PChar); stdcall;
begin
  WriteLn(logf, str);
  MainCtrlForm.Memo.Lines.Add(str);
end;


{$R *.lfm}

{ TMainCtrlForm }

procedure TMainCtrlForm.IdleTimerTimer(Sender: TObject);
var
  P : Pointer;
  I : Integer;
  ls: TStrings;
begin
  filename := FormatDateTime('yyyyy-mm-dd', Now()) + '.txt';
  logfile := logdir + '\' + filename;
  if not FileExists(logfile) then
  begin
    P := @logf;
    if Longint(P^) > 0 then CloseFile(logf);
    AssignFile(logf, logfile);
    Rewrite(logf);
  end;
  if Memo.Lines.Count > 300 then
  begin
    ls := TStrings.Create;
    for I:=Memo.Lines.Count-30 to Memo.Lines.Count-1 do
      ls.Add(Memo.Lines[I]);
    Memo.Lines.Clear;
    for I:=0 to ls.Count-1 do
      Memo.Lines.Add(ls[I]);
    ls.Free;
  end;
end;


procedure TMainCtrlForm.FormCreate(Sender: TObject);
begin
  logdir := ExtractFilePath(ParamStr(0)) + 'logf';
  if not DirectoryExists(logdir) then
   CreateDir(logdir);
  logfile := logdir + '\' + filename;
  AssignFile(logf, logfile);
  if not FileExists(logfile) then
    Rewrite(logf);
  Append(logf);
  execServer(12300);
  //
  CmdClose  := False;
  TrayIcon.Icon := Application.Icon;
end;

procedure TMainCtrlForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
  CanClose := CmdClose;
end;


procedure TMainCtrlForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
  P : Pointer;
begin
  if CmdClose then
  begin
    P := @logf;
    if Longint(P^) > 0 then CloseFile(logf);
    CloseAction := caFree;
    MainCtrlForm := nil;
  end;
end;

procedure TMainCtrlForm.ppmOnShowClick(Sender: TObject);
begin
  Self.Show;
  TrayIcon.Hide;
end;

procedure TMainCtrlForm.ppmOnCloseClick(Sender: TObject);
begin
  //if MessageBox(Handle,PChar(UTF8ToWinCP('确定要退出程序吗?')),'Information',MB_YESNO+MB_ICONINFORMATION)=IDYES then
  CmdClose := True;
  Close;
end;


procedure TMainCtrlForm.OnWMSysCommand(var Msg: TWMSysCommand);
begin
 if (SC_MINIMIZE = Msg.CmdType) or (SC_CLOSE = Msg.CmdType) then //
  begin
    Application.Minimize;
    Self.Hide;
    TrayIcon.Show;
  end
  else inherited;
  //很重要的.上次就是因為沒加這句,導致窗體不能拖動等問題
end;

procedure TMainCtrlForm.FormActivate(Sender: TObject);
begin
  setCallbackFnAccept(@OnAccept);
  setCallbackFnExcept(@OnExcept);
  setCallbackFnReceive(@OnReceive);
end;

end.

